## Chapter 3 (Shared Identities) 
## Our Common Bonds 
## Winter 2021 - 2022  

## Set libraries etc. 
source("ocb_replication_file.r")

###################
## NAES Analyses ## 
################### 

## read in the data 
naes <- read_dta(file="data/naes_data_for_replication.dta") %>% 
  clean_names()

## Code up feeling thermometers and partisanship  
naes <- naes %>% 
  mutate(bho_therm2 = ifelse(a_bo02_2<101,a_bo02_2,NA),
         bho_therm3 = ifelse(naes$a_bo02_3<101,a_bo02_3,NA),
         jm_therm2 = ifelse(a_am01_2<101,a_am01_2,NA),
         jm_therm3 = ifelse(a_am01_3<101,a_am01_3,NA),
         pid = (-1*naes$ma01_3) + 8, 
         dem = ifelse(pid<4,1,
                      ifelse(pid>4,0,NA)), 
         outparty_ft = ifelse(pid<4,jm_therm3,
                              ifelse(pid>4,bho_therm3,NA)), 
         outparty_ft2 = ifelse(pid<4,jm_therm2,
                               ifelse(pid>4,bho_therm2,NA)),
         sameparty_ft =  ifelse(pid>4,jm_therm3,
                                ifelse(pid<4,bho_therm3,NA)))

## Code up the Interview Date 
naes$finish_date <- as.Date(as.character(naes$date_3), format="%Y%m%d") 

################
## Figure 3.5 ## 
################

## July 4th effects 
## 3-day window: July 3-5 vs. June 5-7 or August 7-9 
naes$window3 <- ifelse(((naes$finish_date>"2008-06-04" &
                           naes$finish_date<"2008-06-08") | 
                          (naes$finish_date>"2008-08-06" &
                             naes$finish_date<"2008-08-10")),0,
                       ifelse(naes$finish_date>"2008-07-02" &
                                naes$finish_date<"2008-07-06",1,NA))

pdf(file="figures/chi_levendusky_fig03005.pdf")
naes %>% 
  filter(!is.na(window3)) %>% 
  ggplot() + 
  geom_density(aes(x=outparty_ft, 
                   group=as.factor(window3), 
                   fill=as.factor(window3), 
                   linetype=as.factor(window3)), 
               alpha=0.35) + 
  theme_bw() + 
  ylab("") +
  xlab("Out-Party Candidate Feeling Thermometer") + 
  ggtitle("") + 
  scale_fill_grey(name="", 
                  labels=c("June/August Comparison Days","3-Day Window around July 4"), 
                  start = 0.10, 
                  end = 0.8) + 
  scale_linetype(name="",
                 labels=c("June/August Comparison Days","3-Day Window around July 4"), 
                 limits=c(0,1)) + 
  theme(plot.title = element_text(hjust=0.5),
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank(),
        legend.position = "bottom",
        panel.grid = element_blank()) 
dev.off()

t.test(naes$outparty_ft ~ naes$window3)

################
## Figure 3.6 ## 
################

## 8/15 - 8/17: Phelp's 6th, 7th and 8th gold medals 
## compare to weekend before Olympics 
naes$olympics2 <- ifelse(naes$finish_date>"2008-08-14" & naes$finish_date<"2008-08-18",1, 
                         ifelse(naes$finish_date>"2008-07-31" & naes$finish_date<"2008-08-04",0,NA))
summary(lm(outparty_ft ~ olympics2,
           data = naes))
## 4.8 point effect! 
## effect on 8/16 is basically equivalent to effect of convention speech 

## Draw a graph 
pdf(file="figures/chi_levendusky_fig03006.pdf")
naes %>% 
  filter(!is.na(olympics2)) %>% 
  ggplot() + 
  geom_density(aes(x=outparty_ft, 
                   group=as.factor(olympics2), 
                   fill=as.factor(olympics2), 
                   linetype=as.factor(olympics2)), 
               alpha=0.35) + 
  theme_bw() + 
  ylab("") +
  xlab("Out-Party Candidate Feeling Thermometer") + 
  ggtitle("") + 
  scale_fill_grey(name="", 
                  labels=c("Weekend before the Olympics","Phelps Medal Weekend"), 
                  start = 0.10, 
                  end = 0.8) + 
  scale_linetype(name="",
                 labels=c("Weekend before the Olympics","Phelps Medal Weekend"), 
                 limits=c(0,1)) + 
  theme(plot.title = element_text(hjust=0.5),
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank(),
        legend.position = "bottom",
        panel.grid = element_blank()) 
dev.off() 

## Effect on zero ratings/ratings at 50 or higher 
naes <- naes %>%
  mutate(ft_zero = ifelse(outparty_ft == 0,1,0),
         ft_fifty = ifelse(outparty_ft > 49,1,0))

t.test(naes$ft_zero ~ naes$olympics2) 
t.test(naes$ft_fifty ~ naes$olympics2) 

## Ratings of 0 fall from 24% in the control to 20% during that weekend (20% relative decline) 
## Ratings above 50% jump from 25% to 31%, a boost of one-quarter! 



